home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / ftp.mod (.txt) < prev    next >
Oberon Text  |  1996-07-28  |  19KB  |  471 lines
  1. Syntax10.Scn.Fnt
  2. MODULE FTP;    (* is 13.04.94 *)
  3. (* ARD, Sun, 24-Jul-1994 *)
  4. (* ARD,  22.12.94, Streams *)
  5. (* BD, 13.2.96, new NetSystem interface *)
  6. IMPORT Texts, Oberon, Files, Viewers, MenuViewers, TextFrames, NS := NetSystem, Input;
  7. CONST BufSize = 4100; 
  8.             ControlPort = 21; DataPort = 20;
  9.             CR = 0DX; LF = 0AX;
  10.             connect = 0; user = 1; pass = 2; command = 3; reply = 4; data = 5; end = 6; more = 7;
  11.             cwd = 20; quit = 21; retr = 22; abor = 23; pwd = 24; list = 25; help = 26; 
  12.             noop = 27; type = 28; nlst = 29; cdup = 30; stor = 31; dele = 32; mkd = 33; rmd = 34; nocmd = 35;
  13. TYPE FTPStream = POINTER TO FTPStreamDesc;
  14.         FTPStreamDesc = RECORD
  15.             c: NS.Connection;
  16.             R: Files.Rider
  17.         END;
  18.         Task = POINTER TO TaskDesc;
  19.         TaskDesc = RECORD (Oberon.TaskDesc)
  20.             Stream: FTPStream
  21.         END;
  22. VAR W: Texts.Writer;
  23.         f: Files.File;
  24.         S: Texts.Reader;
  25.         T: Texts.Text;
  26.         V: Viewers.Viewer;
  27.         Control, Data: Task;
  28.         lastch, ch: CHAR;
  29.         X, Y: INTEGER;
  30.         pathname, name, User, Passwd: ARRAY 64 OF CHAR;
  31.         buf, bufD: ARRAY BufSize OF CHAR;
  32.         TypePar: ARRAY 3 OF CHAR;
  33.         state, Cmd, Port, wait: INTEGER;
  34.         last, len, lenD, lenF, tot, Length, OldPerc: LONGINT;
  35.         WriteToFile, SetPort, SetMode, LineF, first, DosFile, RetCmd, FullDir: BOOLEAN;
  36. PROCEDURE Log(s: ARRAY OF CHAR);
  37. BEGIN Texts.WriteString(W, s); Texts.WriteLn(W); Texts.Append(T, W.buf) END Log;    
  38. PROCEDURE SendCommand(cmd, arg: ARRAY OF CHAR);
  39. VAR i, j: INTEGER;
  40. BEGIN i := 0;
  41.     WHILE cmd[i] # 0X DO buf[i] := cmd[i]; INC(i) END;
  42.     IF arg[0] # 0X THEN buf[i] := " "; INC(i); j := 0;
  43.         WHILE arg[j] # 0X DO buf[i] := arg[j]; INC(i); INC(j) END
  44.     END;
  45.     buf[i] := CR; buf[i+1] := LF;
  46.     NS.WriteBytes(Control.Stream.c, 0, i+2, buf)
  47. END SendCommand;
  48. PROCEDURE ChangePort(port: INTEGER);
  49. VAR i, j, k: LONGINT; help: ARRAY 10 OF CHAR; adr: ARRAY 32 OF CHAR; x1, x2: INTEGER;
  50. BEGIN
  51.     i := 0; k:= 0;
  52.     WHILE k < LEN(NS.hostIP) DO
  53.         x1:= ORD(NS.hostIP[k]);
  54.         j:=0; WHILE x1> 0 DO help[j]:= CHR((x1 MOD 10) + ORD("0")); INC(j); x1:= x1 DIV 10 END; DEC(j);
  55.         WHILE j >=0 DO adr[i]:= help[j]; INC(i); DEC(j) END;
  56.         adr[i]:= ",";
  57.         INC(k); INC(i);
  58.     END;
  59.     x1 := port DIV 256; x2 := port MOD 256;
  60.     j := 0; WHILE x1 > 0 DO help[j] := CHR(x1 MOD 10 + ORD("0")); INC(j); x1 := x1 DIV 10 END; DEC(j);
  61.     WHILE j >= 0 DO adr[i] := help[j]; INC(i); DEC(j) END;
  62.     j := 0;
  63.     IF x2 > 0 THEN
  64.         WHILE x2 > 0 DO help[j] := CHR(x2 MOD 10 + ORD("0")); INC(j); x2 := x2 DIV 10 END; DEC(j)
  65.     ELSE help[0] := "0" END;
  66.     adr[i] := ","; INC(i);
  67.     WHILE j >= 0 DO adr[i] := help[j]; INC(i); DEC(j) END;
  68.     adr[i] := 0X;  
  69.     i := 0; WHILE adr[i] # 0X DO IF adr[i] = "." THEN adr[i] := "," END; INC(i) END; 
  70.     SendCommand("PORT", adr);
  71. END ChangePort;
  72. PROCEDURE ReadPath;    
  73. VAR i: INTEGER; 
  74. BEGIN
  75.     i := 0; pathname[i] := 0X;
  76.     WHILE (ch = " ") OR (ch = CR) OR (ch = 9X) DO Texts.Read(S, ch) END;
  77.     WHILE (ch # "~") & (ch # " ") & (ch # "/") & (ch # CR) & (ch # 9X) DO pathname[i] := ch; INC(i); Texts.Read(S, ch) END;
  78.     IF (ch = "/") THEN Texts.Read(S, ch);
  79.         IF (ch = "d") THEN FullDir := TRUE; Texts.Read(S, ch) END
  80.     END;
  81.     pathname[i] := 0X;
  82. END ReadPath;
  83. PROCEDURE SearchName;
  84. VAR i, j: INTEGER;
  85. BEGIN
  86.     i := 0; j := 0;
  87.     WHILE (pathname[i] # 0X) DO IF (pathname[i] = "/") THEN j := i+1 END; INC(i) END;
  88.     IF TRUE THEN i := 0; WHILE (pathname[j] # 0X) DO name[i] := pathname[j]; INC(i); INC(j) END; name[i] := 0X
  89.     ELSE HALT(99) END
  90. END SearchName;
  91. (* Buffer handling ==============================================================================*)
  92. PROCEDURE ResIs(str: ARRAY OF CHAR): BOOLEAN;
  93. BEGIN
  94.     RETURN (buf[0] = str[0]) & (buf[1] = str[1]) & (buf[2] = str[2])
  95. END ResIs;
  96. PROCEDURE WriteText;
  97. VAR num: ARRAY 10 OF CHAR; i, j: LONGINT;
  98. BEGIN 
  99.     IF ResIs("150") & RetCmd THEN i := 0; RetCmd := FALSE; 
  100.         WHILE (buf[i] # "(" ) DO INC(i) END; j := 0; INC(i);
  101.         WHILE (buf[i] # " " ) & (buf[i] # ".") DO num[j] := buf[i]; INC(i); INC(j) END; DEC(j);
  102.         IF (buf[i] = ".") THEN 
  103.             WHILE (buf[i] # "(") DO INC(i) END; j := 0; INC(i);
  104.             WHILE (buf[i] # " " ) DO num[j] := buf[i]; INC(i); INC(j) END; DEC(j)
  105.         END;
  106.         i := 1; Length := 0;
  107.         WHILE (j >= 0) DO Length := Length + (ORD(num[j])-48)*i; i := i*10; DEC(j) END;
  108.     END;
  109.     Texts.WriteString(W, buf); Texts.WriteLn(W);
  110.     IF (V = NIL) OR (V.state <= 0) THEN Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  111.         V := MenuViewers.New(TextFrames.NewMenu("FTP", "System.Close"), TextFrames.NewText(T, 0), TextFrames.menuH, X, Y)
  112.     END;
  113.     Texts.Append(T, W.buf);
  114. END WriteText;
  115. PROCEDURE TransBufW;
  116. VAR i: LONGINT;
  117. BEGIN
  118.     IF (TypePar[0] = "I") THEN 
  119.         i := 0; 
  120.         WHILE (i < lenD) DO 
  121.             IF (bufD[i] # LF) THEN Texts.Write(W, bufD[i]) ELSE Texts.WriteLn(W) END;
  122.             INC(i)
  123.         END
  124.     ELSE
  125.         i := last;
  126.         WHILE (i < lenD) DO 
  127.             IF (bufD[i] # CR) THEN Texts.Write(W, bufD[i]); INC(i) ELSE Texts.WriteLn(W); INC(i,2) END
  128.         END;
  129.         IF (i > lenD) THEN last := i-lenD END
  130.     END;
  131.     Texts.Append(T, W.buf)
  132. END TransBufW;
  133. PROCEDURE TransBufF;
  134. VAR i: INTEGER; Perc: LONGINT;
  135. BEGIN
  136.     i := 0; 
  137.     WHILE (i < lenD) DO
  138.         IF (bufD[i] # LF) & (bufD[i] # CR) THEN Files.Write(Data.Stream.R, bufD[i]); lastch := bufD[i]; INC(tot)
  139.         ELSIF (bufD[i] = CR) THEN Files.Write(Data.Stream.R, bufD[i]); lastch := bufD[i]; INC(tot)
  140.         ELSIF (bufD[i] = LF) & (lastch # CR) THEN Files.Write(Data.Stream.R, CR); lastch := bufD[i]; INC(tot) END;
  141.         INC(i)
  142.     END;
  143.     Perc := ENTIER(tot*100/Length);
  144.     IF (Perc MOD 5 = 0) & (Perc # OldPerc) THEN OldPerc := Perc; Texts.WriteInt(W, Perc, 5); Texts.WriteString(W," %"); 
  145.         IF (Perc = 50) THEN Texts.WriteLn(W) END;
  146.         Texts.Append(T, W.buf)
  147. END TransBufF;
  148. PROCEDURE SendFile(SendType: CHAR);
  149. VAR x: CHAR; len, Perc: LONGINT; 
  150. BEGIN
  151.     IF ~Data.Stream.R.eof THEN 
  152.         IF (SendType = "A") THEN
  153.             lenD := 0;
  154.             IF LineF THEN bufD[lenD] := LF; INC(lenD); LineF := FALSE END;
  155.             Files.Read(Data.Stream.R, x);
  156.             WHILE ~Data.Stream.R.eof & (lenD < BufSize) DO
  157.                 bufD[lenD] := x; INC(lenD);
  158.                 IF (x = CR) & (lenD < BufSize) THEN bufD[lenD] := LF; INC(lenD)
  159.                 ELSIF (x = CR) & (lenD = BufSize) THEN LineF := TRUE END;
  160.                 Files.Read(Data.Stream.R, x); 
  161.             END;
  162.             NS.WriteBytes(Data.Stream.c, 0, lenD, bufD);
  163.         ELSE                                                                    (* Image File *)
  164.             len := lenF - Files.Pos(Data.Stream.R); 
  165.             IF (len <= BufSize) THEN lenD := SHORT(len) ELSE lenD := BufSize END;
  166.             Files.ReadBytes(Data.Stream.R, bufD, lenD);
  167.             NS.WriteBytes(Data.Stream.c, 0, lenD, bufD);
  168.             IF (len <= BufSize) THEN Files.Read(Data.Stream.R, x) END;
  169.         END;
  170.         Perc := ENTIER(100*Files.Pos(Data.Stream.R)/lenF);  
  171.         IF (Perc MOD 5 = 0) & (Perc # OldPerc) THEN OldPerc := Perc; Texts.WriteInt(W, Perc, 5); 
  172.             Texts.WriteString(W," %"); 
  173.             IF (Perc = 50) THEN Texts.WriteLn(W) END;
  174.             Texts.Append(T, W.buf)
  175.         END
  176.     ELSE 
  177.         IF ((SendType = "I") OR (SendType = "A")) & ~LineF THEN        (* Timeout *)
  178.             NS.CloseConnection(Data.Stream.c); 
  179.             Oberon.Remove(Data); Data := NIL; state := reply; f := NIL;
  180.             Log(" file sent");
  181.             ReadPath;
  182.             IF pathname # "" THEN Cmd := stor END
  183.         END
  184. END SendFile;
  185. (* Send & Receive handlers =========================================================================*)
  186. PROCEDURE Receive;
  187. VAR Perc: LONGINT; res: INTEGER;
  188.     newC: NS.Connection;
  189. BEGIN
  190.     INC(Data.time, Input.TimeUnit DIV 4);
  191.     IF NS.Requested(Data.Stream.c) THEN
  192.         NS.Accept(Data.Stream.c, newC, res);
  193.         NS.CloseConnection(Data.Stream.c);
  194.         Data.Stream.c:= newC;
  195.     ELSIF  (NS.Available(Data.Stream.c) > 0) THEN    (* established *)  
  196.         lenD := NS.Available(Data.Stream.c);
  197.         IF lenD > 0 THEN 
  198.             IF lenD > BufSize THEN lenD := BufSize END;
  199.             NS.ReadBytes(Data.Stream.c, 0, lenD, bufD);
  200.             IF ~WriteToFile THEN TransBufW 
  201.             ELSIF (TypePar[0] = "A") THEN TransBufF         (* ASCII File *)
  202.             ELSE Files.WriteBytes(Data.Stream.R, bufD, lenD); tot := tot+lenD; Perc := ENTIER(100*tot/Length);   (* Image File *)
  203.                 IF (Perc MOD 5 = 0) & (Perc # OldPerc) THEN OldPerc := Perc; Texts.WriteInt(W,Perc,5); 
  204.                     Texts.WriteString(W," %"); 
  205.                     IF (Perc = 50) THEN Texts.WriteLn(W) END;
  206.                     Texts.Append(T, W.buf)
  207.                 END 
  208.             END        
  209.         END;
  210.     ELSIF (NS.Available(Control.Stream.c) > 0) & (NS.Available(Data.Stream.c) = 0) THEN 
  211.         NS.CloseConnection(Data.Stream.c); 
  212.         Oberon.Remove(Data); Data := NIL; state := reply;
  213.         IF WriteToFile THEN Texts.WriteLn(W) END;
  214.         Texts.Append(T, W.buf);
  215.         IF (f # NIL) THEN Files.Register(f); f := NIL; tot := 0 END;
  216.         ReadPath;
  217.         IF pathname # "" THEN Cmd := retr END
  218. END Receive;
  219. PROCEDURE Send;
  220. VAR res: INTEGER; newC: NS.Connection;
  221. BEGIN
  222.     INC(Data.time, Input.TimeUnit DIV 4);
  223.     IF NS.Requested(Data.Stream.c) THEN 
  224.         NS.Accept(Data.Stream.c, newC, res);
  225.         NS.CloseConnection(Data.Stream.c);
  226.         Data.Stream.c:= newC;
  227.     ELSIF ((NS.State(Data.Stream.c) = NS.inout) OR (NS.State(Data.Stream.c) = NS.out)) THEN SendFile(TypePar[0]) END
  228.     (* established *)
  229. END Send;
  230. PROCEDURE Handle; 
  231. VAR res: INTEGER;
  232. BEGIN
  233.     INC(Control.time, Input.TimeUnit DIV 4);
  234.     CASE state OF
  235.         connect: 
  236.             IF NS.Available(Control.Stream.c) >= 3 THEN NS.ReadString(Control.Stream.c, buf); WriteText;
  237.                 WHILE buf[3] = "-" DO NS.ReadString(Control.Stream.c, buf); WriteText END;
  238.                 IF ResIs("220") THEN SendCommand("USER", User); state := user
  239.                 ELSIF ResIs("120") THEN    (* wait *)
  240.                 ELSE SendCommand("QUIT", ""); state := end END
  241.             END|
  242.         user:
  243.             IF NS.Available(Control.Stream.c) >= 3 THEN NS.ReadString(Control.Stream.c, buf); WriteText;
  244.                 WHILE buf[3] = "-" DO NS.ReadString(Control.Stream.c, buf); WriteText END;
  245.                 IF ResIs("230") THEN state := command
  246.                 ELSIF ResIs("331") THEN SendCommand("PASS", Passwd); state := pass
  247.                 ELSIF ResIs("530") THEN Log("Login refused"); SendCommand("QUIT", ""); state := end
  248.                 ELSE SendCommand("QUIT", ""); state := end END
  249.             END|
  250.         pass:
  251.             IF NS.Available(Control.Stream.c) >= 3 THEN NS.ReadString(Control.Stream.c, buf); WriteText;
  252.                 IF (buf[3] = "-") THEN state := more; first := FALSE
  253.                 ELSIF ResIs("230") THEN state := command
  254.                 ELSIF ResIs("530") THEN Log("Login refused"); SendCommand("QUIT", ""); state := end 
  255.                 ELSE SendCommand("QUIT", ""); state := end END
  256.             END|
  257.         command:
  258.             CASE Cmd OF
  259.                 pwd: SendCommand("PWD",""); state := reply; Cmd := nocmd|
  260.                 type: SendCommand("TYPE", TypePar); state := reply; Cmd := nocmd|
  261.                 cwd: SendCommand("CWD", pathname); state := reply; Cmd := nocmd|
  262.                 cdup: SendCommand("CDUP", "");  state := reply; Cmd := nocmd|
  263.                 mkd: SendCommand("MKD", pathname);  state := reply; Cmd := nocmd|
  264.                 rmd: SendCommand("RMD", pathname);  state := reply; Cmd := nocmd|
  265.                 help: SendCommand("HELP", name); state := reply; Cmd := nocmd|
  266.                 abor: SendCommand("ABOR", ""); state := reply; Cmd := nocmd|
  267.                 noop: SendCommand("NOOP", ""); state := reply; Cmd := nocmd|
  268.                 quit: SendCommand("QUIT", ""); state := end; Cmd := nocmd|
  269.                 list, nlst: 
  270.                     IF ~SetPort THEN NEW(Data); NEW(Data.Stream);
  271.                         REPEAT INC(Port); 
  272.                             NS.OpenConnection(Data.Stream.c, Port, NS.anyIP, NS.anyport, res) 
  273.                         UNTIL res = NS.done;
  274.                         ChangePort(Port); SetPort := TRUE; state := reply
  275.                     ELSE
  276.                         Data.handle := Receive;
  277.                         SetPort := FALSE; last := 0;
  278.                         IF Cmd = list THEN SendCommand("LIST", pathname) ELSE SendCommand("NLST", pathname) END; 
  279.                         WriteToFile := FALSE; state := reply; Cmd := nocmd;
  280.                     END| 
  281.                 dele: SendCommand("DELE", pathname);  state := reply; 
  282.                     ReadPath;
  283.                     IF pathname # "" THEN Cmd := dele ELSE Cmd := nocmd END|
  284.                 retr: 
  285.                     IF ~SetPort THEN NEW(Data); NEW(Data.Stream);
  286.                         REPEAT INC(Port); 
  287.                             NS.OpenConnection(Data.Stream.c, Port, NS.anyIP, NS.anyport, res)
  288.                         UNTIL res = NS.done;
  289.                         ChangePort(Port); SetPort := TRUE; state := reply
  290.                     ELSIF ~SetMode THEN SendCommand("TYPE", TypePar); SetMode := TRUE; state := reply
  291.                     ELSE
  292.                         Data.handle := Receive;
  293.                         OldPerc := 0; SetPort := FALSE; SetMode := FALSE; last := 0; lastch := 0X; tot := 0; 
  294.                         SendCommand("RETR", pathname); SearchName;
  295.                         (* IF DosFile THEN f := Files.NewDOS(Path) ELSE *)
  296.                         f := Files.New(name);
  297.                         (* END; *) 
  298.                         Files.Set(Data.Stream.R, f, 0);
  299.                         WriteToFile := TRUE; state := reply; Cmd := nocmd; RetCmd := TRUE
  300.                     END|
  301.                 stor:
  302.                     IF ~SetPort THEN NEW(Data); NEW(Data.Stream);
  303.                         REPEAT INC(Port); 
  304.                             NS.OpenConnection(Data.Stream.c, Port, NS.anyIP, NS.anyport, res)
  305.                         UNTIL res = NS.done;
  306.                         ChangePort(Port); SetPort := TRUE; state := reply
  307.                     ELSIF ~SetMode THEN SendCommand("TYPE", TypePar); SetMode := TRUE; state := reply
  308.                     ELSE
  309.                         Data.handle := Send; 
  310.                         OldPerc := 0; SetPort := FALSE; SetMode := FALSE; LineF := FALSE; 
  311.                         SearchName; f := Files.Old(pathname);
  312.                         IF (f # NIL) THEN
  313.                             SendCommand("STOR", pathname);
  314.                             lenF := Files.Length(f); Files.Set(Data.Stream.R, f, 0); 
  315.                             state := reply; Cmd := nocmd
  316.                         ELSE Log(" file not found"); NS.CloseConnection(Data.Stream.c); state := command; Cmd := nocmd END
  317.                     END|
  318.             ELSE END|
  319.         reply:
  320.             IF NS.Available(Control.Stream.c) >= 3 THEN len := NS.Available(Control.Stream.c); NS.ReadString(Control.Stream.c, buf); 
  321.                 wait := 1000;
  322.                 WriteText;
  323.                 IF (buf[3] = "-") THEN state := more; first := FALSE
  324.                 ELSIF ResIs("257") OR ResIs("226") OR ResIs("250") OR ResIs("200") OR ResIs("225") THEN state := command
  325.                 ELSIF ResIs("150") THEN state := data; Oberon.Install(Data) 
  326.                 ELSIF ResIs("421") THEN SendCommand("QUIT", ""); state := end;
  327.                 ELSE state := command;
  328.                     IF (Data # NIL)  & (Data.Stream.c # NIL) THEN NS.CloseConnection(Data.Stream.c); Data := NIL END
  329.                 END
  330.             END|
  331.         more: 
  332.             IF NS.Available(Control.Stream.c) >= 3 THEN 
  333.                 NS.ReadString(Control.Stream.c, buf); wait := 1000; first := TRUE; WriteText; state := more 
  334.             ELSIF first & ResIs("530") THEN SendCommand("QUIT", ""); state := end 
  335.             ELSIF first THEN DEC(wait); IF (wait = 0) THEN state := command END END|    
  336.         data: IF (Cmd = abor) THEN SendCommand("ABOR", ""); state := reply; Cmd := nocmd END|
  337.         end:
  338.             REPEAT UNTIL (NS.Available(Control.Stream.c) > 0);
  339.             NS.ReadString(Control.Stream.c, buf); WriteText;
  340.             NS.CloseConnection(Control.Stream.c); 
  341.             Log(" FTP Stopped"); Oberon.Remove(Control); Control := NIL|
  342.         END
  343. END Handle;
  344. (* Command procedures =======================================================================*)
  345. PROCEDURE Connect*;
  346. VAR S: Texts.Scanner; res: INTEGER;
  347.         remoteIP: NS.IPAdr;
  348. BEGIN
  349.     IF Control = NIL THEN
  350.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); f := NIL;
  351.         Texts.Scan(S); 
  352.         IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN 
  353.             SetPort := FALSE; SetMode := FALSE; TypePar := "A ";
  354.             state := connect; 
  355.             NEW(Control); NEW(Control.Stream); 
  356.             Log(" FTP  (ARD/IS, 9. 1. 95) ");
  357.             Log(" trying to open connection...");
  358.             NS.GetIP(S.s, remoteIP);
  359.             NS.OpenConnection(Control.Stream.c, NS.anyport, remoteIP, ControlPort, res);
  360.             COPY(NS.user, User); COPY(NS.passwd, Passwd); 
  361.             IF res = NS.done THEN 
  362.                 Texts.Scan(S);
  363.                 IF (S.class = Texts.Name) THEN COPY(S.s, User); Texts.Scan(S); Texts.Scan(S);
  364.                     IF (S.class = Texts.Name) THEN COPY(S.s, Passwd) END
  365.                 END;
  366.                 Control.handle := Handle; Oberon.Install(Control)
  367.             ELSIF res = NS.timeout THEN Log("Connect timed out")
  368.             ELSE Log("Not Done") END
  369.         ELSE Log("Invalid name") END
  370.     ELSE Log("Already connected") END
  371. END Connect;
  372. PROCEDURE Start*;
  373. BEGIN
  374.     NS.Start;
  375. END Start;
  376. PROCEDURE Stop*;    (* only in desperate case *)
  377. BEGIN
  378.     IF (Data # NIL) THEN 
  379.         IF (Data.Stream.c # NIL) THEN NS.CloseConnection(Data.Stream.c) END;
  380.         Oberon.Remove(Data); Data := NIL 
  381.     END;
  382.     IF (Control # NIL) THEN 
  383.         IF (Control.Stream.c # NIL) THEN NS.CloseConnection(Control.Stream.c) END; 
  384.         Oberon.Remove(Control); Control := NIL;
  385.     END;
  386.     Log("FTP abnormally stopped")
  387. END Stop;
  388. PROCEDURE SetCmd(cmd: INTEGER; txt: ARRAY OF CHAR);
  389. BEGIN 
  390.     IF (state = command) OR (txt = "FTP.Abort") THEN Cmd := cmd; Log(txt) ELSE Log("previous command not accomplished") END
  391. END SetCmd;
  392. PROCEDURE Clear*;
  393. BEGIN SetCmd(nocmd, "FTP.Clear") END Clear;
  394. PROCEDURE CurrentDir*;
  395. BEGIN SetCmd(pwd, "FTP.CurrentDir") END CurrentDir;
  396. PROCEDURE Disconnect*;
  397. BEGIN SetCmd(quit, "FTP.Disconnect") END Disconnect;
  398. PROCEDURE Abort*;
  399. BEGIN SetCmd(abor, "FTP.Abort") END Abort;
  400. PROCEDURE Check*;
  401. BEGIN SetCmd(noop, "FTP.Check") END Check;
  402. PROCEDURE Directory*;
  403. BEGIN 
  404.     IF state = command THEN Log("FTP.Directory");
  405.         Texts.OpenReader(S, Oberon.Par.text, Oberon.Par.pos); Texts.Read(S, ch);
  406.         FullDir := FALSE; ReadPath; DosFile := FALSE;
  407.         IF FullDir THEN Cmd := list ELSE Cmd := nlst END
  408.     ELSE Log("previous command not accomplished") END
  409. END Directory;
  410. PROCEDURE ChangeDir*;
  411. BEGIN 
  412.     IF state = command THEN Log("FTP.ChangeDir");
  413.         Texts.OpenReader(S, Oberon.Par.text, Oberon.Par.pos); Texts.Read(S, ch);
  414.         ReadPath; 
  415.         IF pathname = ".." THEN Cmd := cdup ELSE Cmd := cwd END
  416.     ELSE Log("previous command not accomplished") END
  417. END ChangeDir;
  418. PROCEDURE GetArg(cmd: INTEGER; txt: ARRAY OF CHAR);
  419. BEGIN
  420.     IF state = command THEN Log(txt);
  421.         Texts.OpenReader(S, Oberon.Par.text, Oberon.Par.pos); Texts.Read(S, ch);
  422.         ReadPath; Cmd := cmd
  423.     ELSE Log("previous command not accomplished") END
  424. END GetArg;
  425. PROCEDURE MakeDir*;
  426. BEGIN GetArg(mkd, "FTP.MakeDir") END MakeDir;
  427. PROCEDURE RemoveDir*;
  428. BEGIN GetArg(rmd, "FTP.RemoveDir") END RemoveDir;
  429. PROCEDURE DeleteFile*;
  430. BEGIN GetArg(dele, "FTP.DeleteFile") END DeleteFile;
  431. PROCEDURE SetType*;
  432. BEGIN GetArg(type, "FTP.SetType"); COPY(pathname, TypePar) END SetType;
  433. PROCEDURE RetrieveFile*;
  434. BEGIN GetArg(retr, "FTP.RetrieveFile"); DosFile := FALSE; TypePar[0] := "I"; TypePar[1] := 0X END RetrieveFile;
  435. PROCEDURE RetrieveText*;
  436. BEGIN GetArg(retr, "FTP.RetrieveText"); DosFile := FALSE; TypePar[0] := "A"; TypePar[1] := 0X END RetrieveText;
  437. PROCEDURE RetrieveDOSFile*;
  438. BEGIN GetArg(retr, "FTP.RetrieveDOSFile"); DosFile := TRUE; TypePar[0] := "I"; TypePar[1] := 0X END RetrieveDOSFile;
  439. PROCEDURE RetrieveDOSText*;
  440. BEGIN GetArg(retr, "FTP.RetrieveDOSText"); DosFile := TRUE; TypePar[0] := "A"; TypePar[1] := 0X END RetrieveDOSText;
  441. PROCEDURE StoreFile*;
  442. BEGIN GetArg(stor, "FTP.StoreFile"); TypePar[0] := "I"; TypePar[1] := 0X END StoreFile;
  443. PROCEDURE StoreText*;
  444. BEGIN GetArg(stor, "FTP.StoreText"); TypePar[0] := "A"; TypePar[1] := 0X END StoreText;
  445. PROCEDURE Help*;
  446. VAR scan: Texts.Scanner; beg, end, time: LONGINT; text: Texts.Text;
  447. BEGIN
  448.     IF state = command THEN
  449.         Texts.OpenScanner(scan, Oberon.Par.text, Oberon.Par.pos);
  450.         Texts.Scan(scan);
  451.         IF (scan.class = Texts.Char) & (scan.c = "^") THEN
  452.             Oberon.GetSelection(text, beg, end, time);
  453.             IF (time >= 0) THEN Texts.OpenScanner(scan, text, beg); Texts.Scan(scan) END;
  454.         END;
  455.         IF (scan.class = Texts.Name) OR (scan.class = Texts.String) THEN COPY(scan.s, name); Cmd := help END
  456. END Help;
  457. PROCEDURE ClearLog*;
  458. VAR F: TextFrames.Frame;
  459. BEGIN
  460.     IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN
  461.         F := V.dsc.next(TextFrames.Frame); Texts.Delete(F.text, 0, F.text.len)
  462.     END;
  463. END ClearLog;
  464. BEGIN 
  465.     Control := NIL; Data := NIL; 
  466.     Port := 1499; RetCmd := FALSE;
  467.     T := TextFrames.Text(""); Texts.OpenWriter(W);
  468.     Oberon.AllocateSystemViewer(Oberon.Mouse.X, X, Y);
  469.     V := MenuViewers.New(TextFrames.NewMenu("FTP", "System.Close  FTP.ClearLog"), TextFrames.NewText(T, 0), TextFrames.menuH, X, Y);
  470. END FTP.
  471.